home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 2 / Atari Mega Archive CD - Volume 2.iso / 8bit / cislib_a / dates.act < prev    next >
Text File  |  1995-04-22  |  10KB  |  625 lines
  1. ;************************************
  2. ;*                                  *
  3. ;*(C)Copyright 1986 by Paul B. Loux *
  4. ;*                                  *
  5. ;* These routines are in the public *
  6. ;* domain,  and  are not to be sold *
  7. ;* for a profit. They may be freely *
  8. ;* distributed, provided  that this *
  9. ;* header remains in place. Use and *
  10. ;* enjoy! PBL, CIS 72337,2073.      *
  11. ;*                                  *
  12. ;************************************
  13. ;
  14. ; File: DATES.LIB
  15. ;
  16. ; Desciption: Library of routines
  17. ;   supporting the input, storage
  18. ;   and manipulation of dates.
  19. ;
  20. ; Requirements: EntryD() utilizes
  21. ;   "EntryS()" (universal  string
  22. ;   entry routine),   "PrintM()"
  23. ;   (output formatter),  and  the
  24. ;   "ValD()"  function   provided
  25. ;   herein.
  26. ;
  27. ; EntryS() is available under the
  28. ;   name ENTRYS.ACT
  29. ;
  30. ; PrintM() is available under the
  31. ;   name PRINTM.ACT
  32. ;
  33. ;************************************
  34. ;
  35. ; CARD FUNC ValD()
  36. ; PROC StrD()
  37. ; PROC Day()
  38. ; CARD FUNC EntryD()
  39. ;
  40. ;************************************
  41. ;
  42. ;   Four routines are provided to
  43. ;   facilitate  the  storage and
  44. ;   manipulation of dates. The
  45. ;   CARD FUNC ValD(<string>) will
  46. ;   convert a date in string format
  47. ;   to a unique CARD value. The
  48. ;   CARD returned by this function
  49. ;   can be used to compute the
  50. ;   number of calender days between
  51. ;   two dates. The string can have
  52. ;   non-numeric characters; for
  53. ;   instance "12/31/85" is legal.
  54. ;   Used together with its converse,
  55. ;   PROC StrD(CARD number,<string>),
  56. ;   it is also possible to find
  57. ;   the calender date which falls
  58. ;   a given number of days before
  59. ;   or after a reference date.
  60. ;   The string returned by StrD()
  61. ;   contains only numbers; formatting
  62. ;   must be performed separately.
  63. ;
  64. ;   PROC Day(CARD number,<string>) 
  65. ;   provides the day of the week
  66. ;   corresponding to a given calender
  67. ;   date, as represented by a CARD
  68. ;   value generated by ValD().
  69. ;
  70. ;   CARD FUNC EntryD() obtains a
  71. ;   date from the keyboard. It uses
  72. ;   EntryS(), the universal string
  73. ;   entry utility; therefore it has
  74. ;   the associated features of error
  75. ;   checking, timeout, etc. EntryD()
  76. ;   will assure the validity of the
  77. ;   entered date, check it against
  78. ;   optional minimum and maximum
  79. ;   dates, and echo succesful entry
  80. ;   in mm-dd-yy format, by use of
  81. ;   PrintM(). The calling program
  82. ;   provides the entry buffer, so
  83. ;   EntryD() can be used to return
  84. ;   a CARD value (as with ValD())
  85. ;   or to obtain an unformatted
  86. ;   string (as with StrD()).
  87. ;
  88. ;   PROC PrintM(<String>,<mask>) and
  89. ;   its variants *ME,*MD,and *MDE 
  90. ;   can be used to print a date in
  91. ;   any format desired, such as
  92. ;   "mm-dd-yy". 
  93. ;
  94. ;   To facilitate usage into the next
  95. ;   century, the date computations
  96. ;   include a 40-year offset. Thus,
  97. ;   the date "043020" is presumed to
  98. ;   mean April 30, 2020. Therefore,
  99. ;   date computations are only valid
  100. ;   for dates within the range from
  101. ;   1-1-1940 through 12-31-2039.
  102. ;   ValD() and StrD() are consistent
  103. ;   in this regard.
  104. ;
  105. ;   Note that more efficient storage
  106. ;   results from use of CARD values
  107. ;   (2 bytes) rather than strings
  108. ;   (5 or 6 bytes plus length byte).
  109. ;   This technique also facilitates
  110. ;   ease in sorting data by date.
  111. ;
  112. ;   Technical note: in general, any
  113. ;   string variable should be pre- 
  114. ;   extended to its maxmium length
  115. ;   prior to making  a call  which
  116. ;   will use it to pass data.
  117. ;
  118. ;
  119. ;************************************
  120. ;
  121. ;    "ValD()"
  122. ;
  123. ;    Convert a date string into
  124. ;    a unique CARD value. Input
  125. ;    expected:
  126. ;
  127. ;        "010185"
  128. ;        "1-01-85"
  129. ;        "Date: 01/01/85"
  130. ;        etc.
  131. ;
  132. ;    NOT: "1/1/85"
  133. ;
  134.  
  135. CARD FUNC ValD(BYTE ARRAY dateS)
  136.  
  137. BYTE ARRAY digits(0)="......"
  138. BYTE ARRAY  month(0)="..",
  139.               day(0)="..",
  140.              year(0)=".."
  141.  
  142. BYTE mm,dd,yy
  143. BYTE dmax,bad_date
  144. BYTE len1
  145. BYTE len2
  146. BYTE ctr,tmp
  147. BYTE xtmp,ztmp
  148.  
  149. CARD value      
  150. INT offset
  151.  
  152.  len1=dateS(0)
  153.  len2=6
  154.  
  155.  DO             ; assure only digits
  156.   tmp=dateS(len1)
  157.   IF (tmp>47 AND tmp <58) THEN
  158.    digits(len2)=tmp
  159.    len2==-1
  160.   FI
  161.   len1==-1
  162.  UNTIL len1=0 OR len2=0
  163.  OD
  164.  
  165.  IF len2>1 THEN      ; 4 or less #'s
  166.   RETURN(0)
  167.  FI
  168.  
  169.  IF len2=1 THEN      ; 5 #'s
  170.   digits(1)=48       ; '0
  171.  FI
  172.  
  173.  digits(0)=6
  174.  
  175.  SCopyS(month,digits,1,2)
  176.  SCopyS(day,digits,3,4)
  177.  SCopyS(year,digits,5,6)
  178.  
  179.  mm=ValB(month)
  180.  dd=ValB(day)
  181.  yy=ValB(year)
  182.  
  183.  bad_date=0
  184.  
  185.  IF mm>12 OR         ; legal date
  186.     mm<1  OR         ; checks
  187.     dd<1  THEN
  188.   bad_date=1
  189.  FI
  190.  
  191.  IF mm=2 THEN
  192.   IF yy MOD 4 THEN
  193.    dmax=28
  194.   ELSE dmax=29
  195.   FI
  196.  ELSEIF
  197.   mm=4  OR
  198.   mm=6  OR
  199.   mm=9  OR
  200.   mm=11 THEN dmax=30
  201.  ELSE dmax=31
  202.  FI
  203.  
  204.  IF dd>dmax THEN
  205.   bad_date=1
  206.  FI
  207.  
  208.  IF bad_date THEN
  209.   RETURN(0)
  210.  FI
  211.  
  212.  IF yy<40 THEN       ; 40 year offset
  213.   yy==+100
  214.  FI
  215.  
  216.  IF mm<3 THEN
  217.   xtmp=0
  218.   ztmp=(yy-1)/4
  219.  ELSE 
  220.   xtmp=(4*mm + 23)/10
  221.   ztmp=yy/4
  222.  FI
  223.  
  224.  mm==-1
  225.        
  226.  value=365*yy+31*mm+dd+ztmp-xtmp  
  227.  
  228. RETURN(value)
  229.  
  230.  
  231. ;************************************
  232. ;
  233. ;    "StrD()"
  234. ;
  235. ;    Restores a date compressed
  236. ;    to a CARD value by ValD(),
  237. ;    into a fixed length string 
  238. ;    of six digital characters;
  239. ;    no formating is performed.
  240. ;    Example output:
  241. ;
  242. ;    "010185"
  243. ;
  244. ;    Note: calling program must 
  245. ;    pre-extend  string "dateS"
  246. ;    to six places.
  247. ;
  248.  
  249. PROC StrD(CARD dateC
  250.           BYTE ARRAY dateS)
  251.  
  252. BYTE ARRAY mm(0)="..",
  253.            dd(0)="..",
  254.            yy(0)=".."
  255.  
  256. BYTE POINTER ptr1,ptr2
  257. INT m,d,y,r,s,t,y1,ly
  258. BYTE dmax
  259.  
  260. y=0
  261. y1=0
  262.  
  263.  IF dateC>36524 THEN  ; yy=1** 
  264.   dateC==-36525
  265.  FI
  266.  
  267.  IF dateC>29220 THEN  ; # too big
  268.   dateC==-7305
  269.   y1=20
  270.  FI
  271.  
  272.  IF dateC<61 THEN     ; handle yr=0
  273.   dateC==+1461
  274.   y1=-4
  275.  FI
  276.  
  277.  y=dateC/365
  278.  
  279.  r=dateC-(y*365)-y/4   
  280.  
  281.  IF r<31 THEN
  282.   y==-1
  283.   r=dateC-(y*365)-y/4
  284.  FI
  285.  
  286.  IF r>59 then
  287.   s=7
  288.  ELSE s=0
  289.  FI
  290.  
  291.  m=(r+s)/31  
  292.  
  293.  ly=(y/4)-((y-1)/4)
  294.  
  295.  IF m<3 THEN
  296.   t=ly
  297.  ELSE
  298.   t=(4*m+23)/10
  299.  FI
  300.  
  301.  IF m=2 THEN
  302.    IF y MOD 4 =0 THEN 
  303.      dmax=29
  304.    ELSE 
  305.      dmax=28
  306.    FI
  307.  ELSEIF m=4
  308.      OR m=6
  309.      OR m=9
  310.      OR m=11 THEN
  311.    dmax=30
  312.  ELSE
  313.    dmax=31
  314.  FI
  315.  
  316.  d=r-31*(m-1)+t
  317.  
  318.  IF d>dmax THEN
  319.   m==+1
  320.   IF m<3 THEN
  321.    t=ly
  322.   ELSE
  323.    t=(4*m+23)/10
  324.   FI
  325.   d=r-31*(m-1)+t
  326.  FI
  327.  
  328.  IF m=13 THEN
  329.   y==+1
  330.   m==-12
  331.  FI
  332.  
  333. y==+y1
  334.  
  335. StrI(m,mm)
  336. StrI(d,dd)
  337. StrI(y,yy)
  338.  
  339. SCopy(dateS,"000000")
  340.  
  341.  ptr1=mm+1
  342.  ptr2=dateS+1
  343.  IF mm(0)=1 THEN
  344.   ptr2==+1
  345.   ptr2^=ptr1^
  346.  ELSE
  347.   ptr2^=ptr1^
  348.   ptr1==+1
  349.   ptr2==+1
  350.   ptr2^=ptr1^
  351.  FI
  352.  
  353.  ptr1=dd+1
  354.  ptr2=dateS+3
  355.  IF dd(0)=1 THEN
  356.   ptr2==+1
  357.   ptr2^=ptr1^
  358.  ELSE
  359.   ptr2^=ptr1^
  360.   ptr1==+1
  361.   ptr2==+1
  362.   ptr2^=ptr1^
  363.  FI
  364.  
  365.  ptr1=yy+1
  366.  ptr2=dateS+5
  367.  IF yy(0)=1 THEN
  368.   ptr2==+1
  369.   ptr2^=ptr1^
  370.  ELSE
  371.   ptr2^=ptr1^
  372.   ptr1==+1
  373.   ptr2==+1
  374.   ptr2^=ptr1^
  375.  FI
  376.  
  377. RETURN
  378.  
  379.  
  380. ;************************************
  381. ;
  382. ;    "Day()"
  383. ;
  384. ;    Day of the week computation
  385. ;
  386. ;    Returns variable-length string
  387. ;    containing  corresponding  day
  388. ;    of the week for the CARD value
  389. ;    supplied. String can be easily
  390. ;    massaged to obtain  upper case
  391. ;    only, first three letters,etc.
  392. ;
  393. ;    Note:  string  "day"  must  be
  394. ;    pre-xtended to 9 places by the
  395. ;    the calling program,  to allow
  396. ;    room for "Wednesday" response.
  397. ;
  398.  
  399. PROC Day(CARD dateC BYTE ARRAY day)
  400.  
  401. CARD ref=[31412] ; Wednesday 1/1/86
  402. INT dif
  403. BYTE num,dir
  404. BYTE ARRAY ptr
  405. CARD ARRAY dow(7)
  406.  
  407. dow(0)="Wednesday"
  408. dow(1)="Thursday"
  409. dow(2)="Friday"
  410. dow(3)="Saturday"
  411. dow(4)="Sunday"
  412. dow(5)="Monday"
  413. dow(6)="Tuesday"
  414. dow(7)="Wednesday"
  415.  
  416. dir=0
  417. dif=dateC-ref
  418. IF dif<0 THEN
  419.   dif=-dif
  420.   dir=1
  421. FI
  422. num=dif MOD 7
  423. IF dir THEN
  424.  num=7-num
  425. FI
  426. ptr=dow(num)
  427.        
  428. SCopy(day,ptr)
  429.  
  430. RETURN
  431.  
  432.  
  433. ;************************************
  434. ;
  435. ;
  436. ;   CARD FUNC EntryD()
  437. ;
  438. ;   Data  entry utility  used to
  439. ;   gather a  calender date from
  440. ;   the keyboard in the "mmddyy"
  441. ;   format. The routine performs
  442. ;   checks for illegal dates and
  443. ;   echoes a  valid  response in
  444. ;   "mm-dd-yy"  format.  Returns
  445. ;   date as a CARD value as  per 
  446. ;   ValD(), or as an unformatted
  447. ;   string as per StrD(). 
  448. ;
  449. ;   This function uses  both the
  450. ;   EntryS() data entry  utility
  451. ;   and the PrintM()  formatter.
  452. ;
  453. ;   Calling  options include the
  454. ;   screen coordinates; high and   
  455. ;   low checks; null-entry flag;
  456. ;   and exit flag, per EntryS(). 
  457. ;
  458. ;
  459. ;************************************
  460.  
  461.  INCLUDE "ENTRYS.ACT"
  462.  
  463.  INCLUDE "PRINTM.ACT"
  464.  
  465. ;************************************
  466.  
  467. MODULE
  468.  
  469. CARD